home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Pixie Scheme ƒ / Pixie Scheme / CheckBook.s next >
Encoding:
Text File  |  1990-03-27  |  4.6 KB  |  137 lines  |  [TEXT/ttxt]
  1. ;     Elementary checkbook–balancer.  Keeps track of the number of pennies
  2. ; in your account, as a 32-bit signed integer, and therefore will fail
  3. ; whenever your account balance much exceeds 20 million dollars (or when
  4. ; you are overdrawn by that amount).
  5. ;
  6. ;     If you have more than 20 million dollars in your checkbook, you
  7. ; can presumably afford better software.  If you are more than 20 million
  8. ; dollars overdrawn, I doubt that better software will help.
  9.  
  10.  
  11. ;;;     The following symbols will be rebound globally to appropriate
  12. ;;; functions, when "make-checkbook" is called.
  13.  
  14. (define c #f)     ;; Account for writing a check, eg (c 49.95).
  15. (define d #f)     ;; Account for making a deposit, eg (d 1000).
  16. (define l #f)     ;; Print ledger: (l).
  17. (define u #f)     ;; Undo last "c" or "d":  (u).
  18.  
  19.  
  20. ;;;     MAKE-CHECKBOOK     Create a checkbook with the given balance.
  21.  
  22. (define (make-checkbook brought-forward)
  23.   (let* 
  24.     ((balance brought-forward)
  25.      (ledger (list (list 'brought-forward #f brought-forward)))
  26.      (debit (lambda (amount) (set! balance (- balance amount))))
  27.      (credit (lambda (amount) (set! balance (+ balance amount))))
  28.      (enter (lambda (transaction)
  29.                    (set! ledger (cons transaction ledger))) )
  30.      (remove-last-transaction (lambda () 
  31.                                 (set! ledger (cdr ledger)) ) )
  32.      (last-transaction(lambda () (car ledger)))
  33.      (make-check-transaction (lambda (amount)
  34.                                (list 'check amount balance) ) )
  35.      (make-deposit-transaction (lambda (amount)
  36.                                  (list 'deposit amount balance) ) )
  37.      )
  38.     (set! c
  39.           (lambda (amount)
  40.             (debit amount)
  41.             (enter (make-check-transaction amount))                          
  42.             (transaction-string (last-transaction)) ) )
  43.     (set! d (lambda (amount)
  44.               (credit amount)
  45.               (enter (make-deposit-transaction amount))
  46.               (transaction-string (last-transaction)) ) )
  47.     (set! u (lambda ()
  48.               (let ((removed (last-transaction)))
  49.                 (remove-last-transaction)
  50.                 (set! balance (transaction-balance (last-transaction)))
  51.                 (transaction-string removed)
  52.                 #t ) ) )
  53.     (set! l (lambda ()
  54.               (display "   Check     Deposit    Balance") (newline)
  55.               (display " =========  =========  =========") (newline)
  56.               (for-each (lambda (transaction)
  57.                           (display (transaction-string transaction))
  58.                           (newline) )
  59.                         (reverse ledger) )
  60.               #t ) )
  61.     ) )
  62.  
  63. (define transaction-amount cadr)
  64.  
  65. (define transaction-balance caddr)
  66.  
  67. (define transaction-type car)
  68.  
  69. (define (transaction-string transaction)
  70.   (let ((type (car transaction)))
  71.     (cond ((equal? type 'check)
  72.            (string-append 
  73.             (dollar->string (transaction-amount transaction))
  74.             "           "
  75.             (dollar->string (transaction-balance transaction)) ) )
  76.           ((equal? type 'deposit)
  77.            (string-append 
  78.             "           "
  79.             (dollar->string (transaction-amount transaction))
  80.             (dollar->string (transaction-balance transaction)) ) )
  81.           ((equal? type 'brought-forward)
  82.            (string-append
  83.             "                      " 
  84.             (dollar->string (transaction-balance transaction)) ) )
  85.           (else 
  86.            (error "Unknown transaction type:" type) ) )
  87.     ) )
  88.  
  89. (define (string-index char string)
  90.   (do ((i 0 (+ i 1))
  91.        (l (string-length string))
  92.        (found? #f) )
  93.       ((or found? 
  94.            (>= i l) )
  95.        found? )
  96.       (if (char=? (string-ref string i) char)
  97.           (set! found? i) ) ) )
  98.  
  99. (define (dollar->string x)
  100.   (let*
  101.     ((sign-string 
  102.       (if (positive? x)
  103.           " "
  104.           "-" ) )
  105.      (dollars (floor (abs x)))
  106.      (dollar-string (number->string dollars '(int)))
  107.      (cents (* 100 (- (abs x) dollars)))
  108.      (cent-string (substring (number->string (+ 100.5 cents) '(fix 1)) 1 3))
  109.      (leading-blanks
  110.       (-
  111.        9
  112.        (+ 1 
  113.           (string-length dollar-string) 
  114.           1 
  115.           (string-length cent-string)
  116.           )
  117.        ) )
  118.      )
  119.     (if (negative? leading-blanks)
  120.         (error "Number too large:" x) )
  121.     (let ((blank-string (make-string (+ leading-blanks 1) #\space)))
  122.       (string-append 
  123.        blank-string 
  124.        sign-string 
  125.        dollar-string
  126.        "." 
  127.        cent-string
  128.        " " ) ) ) )
  129.  
  130. (define (error message x)
  131.   (begin (newline)
  132.          (display "Error: ")
  133.          (display message)
  134.          (display " ")
  135.          (display x)
  136.          (newline) ) )
  137.